home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / pdrd2.zip / RD.ZIP / RD_TOUR.PRG < prev    next >
Text File  |  1993-01-11  |  16KB  |  453 lines
  1. /*
  2.     RD_TOUR.PRG
  3. */
  4.  
  5. #include "inkey.ch"
  6. #include "read.ch"
  7.  
  8. //---------
  9. func main()
  10. local nTop := 3, nLeft := 0
  11. local aMenu := {;
  12.                     "Overview: What's the Get/Read Collection?",;
  13.                     "The ADread() Syntax",;
  14.                     "The Default Active Keys and Mouse Spots",;
  15.                     "Demo: The Basic Implementation",;
  16.                     "The ADread() APIs",;
  17.                     "Demos: Extending Its Functionality",;
  18.                     "A Quick Syntax Reference";
  19.                }
  20. local aTrigger := { 1,14,20,11,14,22,16 }
  21. local aBlock := {;
  22.                     {|e| ADviewfile( "overview.rd" )},;
  23.                     {|e| ADviewfile( "syntax.rd" )},;
  24.                     {|e| ADviewfile( "keys.rd" )},;
  25.                     {|e| ADviewfile( "rd_demo1.prg", {||Xdemo1()} )},;
  26.                     {|e| ADviewfile( "api.rd" )},;
  27.                     {|e| Xfunction(e)},;
  28.                     {|e| ADviewfile( "quickref.rd" )};
  29.                 }
  30.  
  31. Xintro()
  32. ADvermenu( nTop, nLeft, aMenu, aTrigger, aBlock )
  33. ADcredit(13,16)
  34. setblink( .t. )
  35. return nil
  36.  
  37.  
  38. //--------------------
  39. func Xfunction( e, cDbf )
  40. local nTop := ADvm_row(e) + 1, nLeft := ADvm_left(e) + 4
  41. local aMenu := {;
  42.                     "Timed Out Feature",;
  43.                     "Popup Picklist, Jump to any Get",;
  44.                     "Hot Keys",;
  45.                     "Hot Spots",;
  46.                     "Reactivating an Exited Read",;
  47.                     "Changing the Memoedit Attributes",;
  48.                     "Key-wise Validation";
  49.                }
  50. local xBlock := {;
  51.                     {|e| ADviewfile( "rd_demo2.prg", {||Xdemo2()} )},;
  52.                     {|e| ADviewfile( "rd_demo3.prg", {||Xdemo3()} )},;
  53.                     {|e| ADviewfile( "rd_demo4.prg", {||Xdemo4()} )},;
  54.                     {|e| ADviewfile( "rd_demo5.prg", {||Xdemo5()} )},;
  55.                     {|e| ADviewfile( "rd_demo6.prg", {||Xdemo6()} )},;
  56.                     {|e| ADviewfile( "rd_demo7.prg", {||Xdemo7()} )},;
  57.                     {|e| ADviewfile( "rd_demo8.prg", {||Xdemo8()} )};
  58.                 }
  59. ADvermenu( nTop, nLeft, aMenu, {1,1,5,5,1,14,10}, xBlock )
  60. return nil
  61.  
  62.  
  63. //-----------------
  64. func Xdemo1()
  65. local getlist[0]
  66. local cShort := "Short string"
  67. local cLong := "This is a very long string.  It is '@S PICTUREd'.  This is the last of three sentences."
  68. local nNumber := 9
  69. local lLogical := .t.
  70. local dDate := date()
  71. local aArray := { "Frankie", "Library" }
  72. local nT := 10, nL := 10, nB := 18, nR := 50
  73. local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, N/R", nil ) )
  74. local aScn, aScn2
  75.  
  76. aScn = ADbox( nT, nL, nB, nR )
  77. aScn2 = ADmessage( { "Choose option #3 from the main menu to get acquainted with the active",;
  78.                      "keys and mouse spots." },;
  79.                    20,, .f., .f. )
  80. @nT+1, nL+2 say "Short String" adget cShort
  81. @nT+2, nL+2 say "Long String " adget cLong picture "@S24"
  82. @nT+3, nL+2 say "Numeric     " adget nNumber
  83. @nT+4, nL+2 say "Logical     " adget lLogical
  84. @nT+5, nL+2 say "Date        " adget dDate
  85. @nT+6, nL+2 say "Array Elem1 " adget aArray[1]
  86. @nT+7, nL+2 say "Array Elem2 " adget aArray[2]
  87. ADread( getlist )
  88. ADrestscn( aScn2 )
  89. ADrestscn( aScn )
  90. setcolor( cColor )
  91. return nil
  92.  
  93. //-----------
  94. func Xdemo2()
  95. local getlist[0]
  96. local cShort := "Short string"
  97. local cLong := "This is a very long string.  It is '@S PICTUREd'.  This is the last of three sentences."
  98. local nNumber := 9
  99. local lLogical := .t.
  100. local dDate := date()
  101. local aArray := { "Frankie", "Library" }
  102. local nT := 10, nL := 10, nB := 18, nR := 50
  103. local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, N/R", nil ) )
  104. local aScn, aScn2
  105. local bConfig := {|e| ADr_timedout( e, { 3, {||ADmessage( {"Timed Out!"} )} } )}
  106.  
  107. aScn = ADbox( nT, nL, nB, nR )
  108. aScn2 = ADmessage( { "The Read times out every 3 clock ticks of idle period" },;
  109.                    20,, .f., .f. )
  110. @nT+1, nL+2 say "Short String" adget cShort
  111. @nT+2, nL+2 say "Long String " adget cLong picture "@S24"
  112. @nT+3, nL+2 say "Numeric     " adget nNumber
  113. @nT+4, nL+2 say "Logical     " adget lLogical
  114. @nT+5, nL+2 say "Date        " adget dDate
  115. @nT+6, nL+2 say "Array Elem1 " adget aArray[1]
  116. @nT+7, nL+2 say "Array Elem2 " adget aArray[2]
  117. ADread( getlist, bConfig )
  118. ADrestscn( aScn2 )
  119. ADrestscn( aScn )
  120. setcolor( cColor )
  121. return nil
  122.  
  123. //-----------
  124. func Xdemo3()
  125. local aPayModes := { "Cash       ",;
  126.                      "Credit Card",;
  127.                      "Check      " }
  128. local aCards := { "Visa      ",;
  129.                   "MasterCard",;
  130.                   "Discover  " }
  131. local getlist[0]
  132. local cPayMode := space(11)
  133. local cCardType := space(10)
  134. local cCardNumber := space(16)
  135. local nAmount := 0
  136. local nT := 10, nL := 10, nB := 15, nR := 42
  137. local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, N/R", nil ) )
  138. local aScn, aScn2
  139. local bConfig := {|e| ADr_keys( e,;
  140.                                 {K_ALT_F1, K_F10},;
  141.                                 {|e,nth,nkey| Xkeys3(e,nth,nkey,aPayModes,aCards)};
  142.                               );
  143.                   }
  144.  
  145. aScn = ADbox( nT, nL, nB, nR )
  146. aScn2 = ADmessage( {;
  147.                         "Popups are attached to 'Payment mode' and 'Card type'.",;
  148.                         "Activate them by pressing ALT-F1 or by keying in an invalid",;
  149.                         "entry.",;
  150.                         "You may also press F10 to blank all Gets";
  151.                    },;
  152.                    18,, .f., .f.;
  153.                  )
  154. @nT+1, nL+2 say "Payment mode" adget cPayMode;
  155.                                valid {|e,_x| _x := ADr_popup( e, row()+1, col()+3, aPayModes, {4,11,5} ),;
  156.                                              _x != 0 }
  157. @nT+2, nL+2 say "Card type   " adget cCardType;
  158.                                valid {|e| ADr_popup( e, row()+1, col()+3, aCards ) > 0};
  159.                                when ( cPayMode == "Credit Card" )
  160. @nT+3, nL+2 say "Card number " adget cCardNumber;
  161.                                valid {|e| ADr_required(e)};
  162.                                when ( cPayMode == "Credit Card" )
  163. @nT+4, nL+2 say "Amount      " adget nAmount picture "99999.99"
  164. ADread( getlist, bConfig )
  165. ADrestscn( aScn2 )
  166. ADrestscn( aScn )
  167. setcolor( cColor )
  168. return nil
  169.  
  170. //------------------------------------------
  171. func Xkeys3( e, nth, nkey, aPayMode, aCards )
  172. if nkey = K_ALT_F1
  173.     Xpopup3( e, aPayMode, aCards )
  174. elseif nkey = K_F10
  175.     ADr_blank( e, {} )
  176.     ADr_jump( e, 1, .t. )
  177. endif
  178. return nil
  179.  
  180.  
  181. //-------------------------------
  182. func Xpopup3(e, aPayModes, aCards)
  183. local nthGet := ADr_nthget(e)
  184.  
  185. if nthGet = 1
  186.     ADr_popup( e, row()+1, col()+3, aPayModes, {4,11,5}, .t. )
  187. elseif nthGet = 2
  188.     ADr_popup( e, row()+1, col()+3, aCards,, .t. )
  189. else
  190.     tone(100,1)
  191. endif
  192. return nil
  193.  
  194.  
  195. //-----------
  196. func Xdemo4()
  197. local getlist[0]
  198. local cShort := "Short string"
  199. local cLong := "This is a very long string.  It is '@S PICTUREd'.  This is the last of three sentences."
  200. local nNumber := 9
  201. local lLogical := .t.
  202. local dDate := date()
  203. local aArray := { "Frankie", "Library" }
  204. local nT := 2, nL := 10, nB := 10, nR := 50
  205. local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, N/R", nil ) )
  206. local aScn, aScn2
  207. local bConfig := {|e| ADr_keys( e, { K_F7, K_F8, K_F9, K_F10 },;
  208.                                    {|e,nth,nkey|Xkeys4(e,nth,nkey)};
  209.                               ),;
  210.                       ADr_exit( e, {|e| ADr_filled( e,;
  211.                                                     { 1, 2, 5 },;
  212.                                                     {|| ADmessage({ "Fields 1, 2, and 5 may not be left blank"})};
  213.                                                   );
  214.                                    };
  215.                               );
  216.                  }
  217.  
  218. aScn = ADbox( nT, nL, nB, nR )
  219. @nT+1, nL+2 say "Short String" adget cShort
  220. @nT+2, nL+2 say "Long String " adget cLong picture "@S24"
  221. @nT+3, nL+2 say "Numeric     " adget nNumber
  222.  
  223. @nT+4, nL+2 say "Logical     " adget lLogical
  224. @nT+5, nL+2 say "Date        " adget dDate
  225. @nT+6, nL+2 say "Array Elem1 " adget aArray[1]
  226. @nT+7, nL+2 say "Array Elem2 " adget aArray[2]
  227. aScn2 = ADmessage( { "The following are hot keys:",;
  228.                      "  F7 - blanks the current Get",;
  229.                      "  F8 - blanks Get #2",;
  230.                      "  F9 - blanks Get #s 6 and 7",;
  231.                      "  F10 - blanks all Gets",;
  232.                      "",;
  233.                      "The Read will not be saved if any of Get #s 1, 2, or 5",;
  234.                      "is empty";
  235.                     }, 13,, .f., .f. )
  236. ADread( getlist, bConfig )
  237. ADrestscn( aScn )
  238. ADrestscn( aScn2 )
  239. setcolor( cColor )
  240. return nil
  241.  
  242.  
  243. //-----------------------
  244. func Xkeys4(e, nth, nkey )
  245. if nth = 1
  246.     ADr_blank( e )
  247. elseif nth = 2
  248.     ADr_blank( e, 2 )
  249. elseif nth = 3
  250.     ADr_blank( e, { 6, 7 } )
  251. elseif nth = 4
  252.     ADr_blank( e, {} )
  253. endif
  254. return nil
  255.  
  256.  
  257. //-----------
  258. func Xdemo5()
  259. local getlist[0]
  260. local cShort := "Short string"
  261. local cLong := "This is a very long string.  It is '@S PICTUREd'.  This is the last of three sentences."
  262. local nT := 3, nL := 10, nB := 6, nR := 50
  263. local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, N/R", nil ) )
  264. local aScn, aScn2
  265. local bConfig := {|e| ADr_lbuttons( e,;
  266.                                     { {nT-1,31,nT-1,34}, {nT-1,38,nT-1,49} },;
  267.                                     {|e,nth,mrow,mcol| Xbuttons5(e,nth,mrow,mcol,nB)};
  268.                                   );
  269.                   }
  270.  
  271. aScn = ADbox( nT, nL, nB, nR )
  272. aScn2 = ADsavescn( nT-1, nL, nT-1, nR )
  273. setpos( nT-1, nL )
  274. dispout( " Hot Spots -->       Beep │ View Keys.Rd ", if( iscolor(), "W+/B", "N/W" ) )
  275. @nT+1, nL+2 say "Short String" adget cShort
  276. @nT+2, nL+2 say "Long String " adget cLong picture "@S24"
  277. ADread( getlist, bConfig )
  278. ADrestscn( aScn2 )
  279. ADrestscn( aScn )
  280. setcolor( cColor )
  281. return nil
  282.  
  283.  
  284. //--------------------------------
  285. func Xbuttons5(e,nth,mrow,mcol,nB)
  286.  
  287. if nth = 1
  288.     tone(100,1)
  289. elseif nth = 2
  290.     ADm_rwait()
  291.     ADviewfile( "KEYS.RD",, {nB+2} )
  292. endif
  293. return nil
  294.  
  295.  
  296. //-----------
  297. func Xdemo6()
  298. local getlist[0]
  299. local cShort := "Short string"
  300. local cLong := "This is a very long string.  It is '@S PICTUREd'.  This is the last of three sentences."
  301. local nT := 10, nL := 10, nB := 13, nR := 50
  302. local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, N/R", nil ) )
  303. local aScn, aScn2, aReadRetval
  304. #define DO_NOT_KILL     .f.
  305. #define READ_ENGINE     aReadRetval[1]
  306.  
  307. aScn = ADbox( nT, nL, nB, nR )
  308. aScn2 = ADmessage( { "This example will demonstrate how to reactivate an exited Read"},;
  309.                      20,, .f., .f. )
  310. @nT+1, nL+2 say "Short String" adget cShort
  311. @nT+2, nL+2 say "Long String " adget cLong picture "@S24"
  312. aReadRetval = ADread( getlist,,, DO_NOT_KILL )
  313. ADrestscn( aScn2 )
  314. aScn = ADrestscn( aScn )
  315. ADmessage( {;
  316.              "You have exited the Read.  The Read engine, however, continues to 'live'.",;
  317.              "You may re-activate it any time you want to.  In this demo, we will",;
  318.              "do that as soon as you press any key.  The reactivated Read, by default,",;
  319.              "will consist of empty Gets, and Get #1 will have the initial focus. ";
  320.            },18 )
  321. aScn = ADrestscn( aScn )
  322. ADr_again( READ_ENGINE )
  323. ADrestscn( aScn )
  324. setcolor( cColor )
  325. return nil
  326.  
  327. //-----------
  328. func Xdemo7()
  329. local getlist[0]
  330. local cShort := "Short string"
  331. local cLong := "This is a very long string.  Press 'Tab' to expand it into a memoedit."
  332. local nT := 10, nL := 10, nB := 13, nR := 50
  333. local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, N/R", nil ) )
  334. local aScn, aScn2
  335. local bConfig := {|e| ADr_expattr( e,;
  336.                                    {0,0,4,31},;
  337.                                    if( iscolor(), "W+/B", "W+/N" ),;
  338.                                    "┌─┐│┘─└│ ",;
  339.                                    "Esc:Exit    Tab:Sauv    F1:Aide";
  340.                                  );
  341.                  }
  342.  
  343. aScn = ADbox( nT, nL, nB, nR )
  344. aScn2 = ADmessage( { "This changes the default attributes of the expanded Get" },;
  345.                    22,, .f., .f. )
  346. @nT+1, nL+2 say "Short String" adget cShort
  347. @nT+2, nL+2 say "Long String " adget cLong picture "@S24"
  348. ADread( getlist, bConfig )
  349. ADrestscn( aScn2 )
  350. ADrestscn( aScn )
  351. setcolor( cColor )
  352. return nil
  353.  
  354.  
  355. func Xdemo8()
  356. local getlist[0]
  357. local dDate := date()  
  358. local cIdNum := "A000"
  359. local nT := 4, nL := 10, nB := 7, nR := 26
  360. local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, N/R", nil ) )
  361. local aScn, aScn2
  362. local bConfig := {|e| ADr_keyvalid( e,{|cKey,nPos,nthGet,cBuffer| Xkeyvalid(cKey,nPos,nthGet,cBuffer)} )}
  363.  
  364. aScn = ADbox( nT, nL, nB, nR )
  365. @nT+1, nL+2 say "Date" adget dDate
  366. @nT+2, nL+2 say "ID #" adget cIdNum picture "!999"
  367. aScn2 = ADmessage( { "Every key is validated.  For example, you cannot enter a '3' in",;
  368.                      "the Date's first position.  Neither can you enter anything higher",;
  369.                      "than '2' if the first is a '0'.  As for ID #, you can only enter",;
  370.                      "either an 'A' or a 'B' in the first position, and only digits in",;
  371.                      "the other positions.";
  372.                    }, 16,, .f., .f. )
  373. ADread( getlist, bConfig )
  374. ADrestscn( aScn2 )
  375. ADrestscn( aScn )
  376. setcolor( cColor )
  377. return nil
  378.  
  379.  
  380. //-------------------------------------------
  381. func Xkeyvalid( cKey, nPos, nthGet, cBuffer )
  382. local lValid := .t.
  383.  
  384. if nthGet = 1
  385.     if nPos = 1
  386.         if !cKey $ "01"
  387.             ADmessage( { "Only '0' and '1' are valid in the first position" } )
  388.             lValid = .f.
  389.         endif
  390.     elseif nPos = 2
  391.         if left( cBuffer, 1 ) == "0" .and. cKey == "0"
  392.             ADmessage( { "'0' is not valid in the second position" } )
  393.             lValid = .f.
  394.         elseif left( cBuffer, 1 ) == "1" .and. !cKey $ "012"
  395.             ADmessage( { "Only '0', '1' and '2' are valid in the second position" } )
  396.             lValid = .f.
  397.         endif
  398.     elseif nPos = 4
  399.         if !cKey $ "0123"
  400.             ADmessage( { "Only '0', '1', '2', and '3' are valid in the 4th position" } )
  401.             lValid = .f.
  402.         endif
  403.     elseif nPos = 5
  404.         if substr( cBuffer, 4, 1 ) == "3" .and. !cKey $ "01"
  405.             ADmessage( { "'0' and '1' are valid in the 5th position" } )
  406.             lValid = .f.
  407.         endif
  408.     elseif nPos = 7
  409.         if cKey != "9"
  410.             ADmessage( { "Only '9' is valid in the 7th position" } )
  411.             lValid = .f.
  412.         endif
  413.     elseif nPos = 8
  414.         if !cKey $ "0123"
  415.             ADmessage( { "Only '0', '1', '2', and '3' are valid in the last position" } )
  416.             lValid = .f.
  417.         endif
  418.     endif
  419. elseif nthGet = 2
  420.     if nPos = 1
  421.         if !cKey $ "ABab"
  422.             ADmessage( { "Only 'A' and 'B' are valid in the first position" } )
  423.             lValid = .f.
  424.         endif
  425.     else
  426.         if !cKey $ "0123456789"
  427.             ADmessage( { "Only digits are valid in the 2nd to the last positions" } )
  428.             lValid = .f.
  429.         endif
  430.     endif
  431. endif
  432. return lValid
  433.  
  434.  
  435. //-----------
  436. func Xintro()
  437. cls
  438. ADmessage( {;
  439.                 "The Get/Read Collection of the Frankie Library",;
  440.                 "Version 1.02",;
  441.                 "A Mouseable and Extensible Read Engine and APIs",;
  442.                 "═══════════════════════════════════════════════",;
  443.                 "",;
  444.                 "Copyright (c) The Programmer's Desk, 1992, 1993",;
  445.                 "Press any key";
  446.            }, 7, 10, .f. )
  447. ADxwait()
  448. return nil
  449.  
  450.  
  451.  
  452.  
  453.